home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / copymove.swg / 0004_Copy File #4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  2.4 KB  |  96 lines
  1. {I am having a bit of a problem in Pascal.  I am writing a routine to
  2. copy Files.  The Program is to be used in an area where anything at
  3. all can happen, so it has to be totally bullet-proof.  All is well,
  4. except one little thing.  Should the Program encounter a major disk
  5. error (for example, the user removes the disk While the copy is taking
  6. place), the Program breaks into Dos after an 'Abort, Retry, Fail'
  7. prompt.  Now comes the weird part.  This crash to Dos only occurs only
  8. once the Program terminates.  It processes the error perfectly, and only
  9. gives the error once my entire Program is at an end!  Following is the
  10. source code in question:
  11. }
  12. Program FileTest;
  13.  
  14. Uses
  15.   Dos;
  16.  
  17. Procedure FileCopy(SrcPath, DstPath, FSpec : String; Var ExStat : Integer);
  18. Var
  19.   DirInfo : SearchRec;
  20.   Done    : Boolean;
  21.  
  22. Procedure Process(X : String);
  23. Var
  24.   Source,
  25.   Dest     : File;
  26.   Buffer   : Array[1..4096] of Byte;
  27.   ReadCnt,
  28.   WriteCnt : Word;
  29.  
  30. begin
  31.   {$I-}
  32.   ExStat:=0;
  33.   Assign(Source,SrcPath+X);
  34.   Reset(Source,1);
  35.   If IOResult <> 0 then
  36.     ExStat := 1;
  37.   If ExStat = 0 then
  38.   begin
  39.     Assign(Dest,DstPath+X);
  40.     ReWrite(Dest,1);
  41.     If IOResult <> 0 then
  42.       ExStat := 2;
  43.     If ExStat = 0 then
  44.     begin
  45.       Repeat
  46.         BlockRead(Source,Buffer,Sizeof(Buffer),ReadCnt);
  47.         BlockWrite(Dest,Buffer,ReadCnt,WriteCnt);
  48.         If IOResult <> 0 then
  49.           ExStat := 3;
  50.       Until (ReadCnt = 0) or (WriteCnt <> ReadCnt) or (ExStat <> 0);
  51.       Close(Dest);
  52.     end;
  53.     Close(Source);
  54.   end;
  55.   {$I+}
  56. end;
  57.  
  58. begin
  59.   {$I-}
  60.     ExStat := 0;
  61.     FindFirst(SrcPath + FSpec, Archive, DirInfo);
  62.     Done := False;
  63.     While Not Done do
  64.     begin
  65.       Write('Copying ',DirInfo.Name,' ');
  66.       Process(DirInfo.Name);
  67.       If (ExStat = 0) then
  68.       begin
  69.         FindNext(DirInfo);
  70.         If (DosError<>0) then
  71.           Done := True;
  72.       end
  73.       else
  74.         Done := True;
  75.     end;
  76.   {$I+}
  77. end;
  78.  
  79. Procedure Main;
  80. Var
  81.   ExC : Integer;
  82. begin
  83.   FileCopy('C:\Dos\','A:\','*.BAS',ExC);
  84.   Writeln('Exit Code:',ExC);
  85. end;
  86.  
  87. begin
  88.   Main;
  89.   Writeln('Program is Complete');
  90. end.
  91. {
  92. That's it.  All errors get logged normally, and right after 'Program is
  93. Complete', I get an 'Abort, Retry, Fail'.  It must be a File left open,
  94. and TP tries to close it once the Program terminates, but I can't
  95. imagine which File it might be!
  96. }